home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / simula / books / books.lha / kirkerud / histo3.sim < prev    next >
Text File  |  1993-08-16  |  3KB  |  86 lines
  1. ! Proposed solution to exercise 4.1 (Robust histogram program);
  2.  
  3. begin
  4.  
  5.   integer array count(5 : 200);
  6.   integer weight_group, least_weight_group,  greatest_weight_group,
  7.           number_of_weights, max_weights_in_group, weights_per_asterisk, 
  8.           asterisk_number, number_of_asterisks;
  9.   real    weight;
  10.  
  11. ! Read the measurements one by one:   ;
  12.    outtext(" Please type the weights. "); outimage;
  13.    outtext(" Remember to type -1 after the last one!");  outimage;
  14.    number_of_weights := 0;
  15.    weight := inreal;
  16.    while weight ge 0 do
  17.    begin
  18.      if weight < 5 then 
  19.        begin 
  20.          outtext("The weight "); outfix(weight, 2, 0);
  21.          outtext(" is too small.  Not accepted."); outimage;
  22.        end else
  23.      if weight > 200 then 
  24.        begin 
  25.          outtext("The weight "); outfix(weight, 2, 0);
  26.          outtext(" is too great.  Not accepted."); outimage;
  27.        end
  28.      else begin
  29.          weight_group := entier(weight);
  30.          count(weight_group) := count(weight_group) + 1;
  31.          number_of_weights := number_of_weights + 1;
  32.        end;
  33.      weight := inreal;
  34.    end of weight ge 0;
  35.  
  36.   if number_of_weights = 0 then 
  37.     begin 
  38.       outtext("You did not type any acceptable weights."); outimage;
  39.       outtext("   No histogram is produced."); outimage;
  40.     end
  41.   else begin
  42.  
  43.   ! Find the least and greatest weight_groups containing weights:  ;
  44.      least_weight_group := 5;
  45.      while count(least_weight_group) = 0
  46.        do least_weight_group := least_weight_group + 1;
  47.      greatest_weight_group := 200;
  48.      while count(greatest_weight_group) = 0
  49.        do greatest_weight_group :=  greatest_weight_group - 1;
  50.  
  51.   ! Find the maximum number of observations in a group:  ;
  52.      max_weights_in_group := count(least_weight_group);
  53.      for weight_group := least_weight_group + 1 step 1 until greatest_weight_group
  54.        do max_weights_in_group := max(max_weights_in_group, count(weight_group));
  55.  
  56.   ! Compute the number of weights per asterisk in the histogram:
  57.   !    (Assumes that no line in the histogram may contain more than 50 asterisks);
  58.      weights_per_asterisk := 1 + max_weights_in_group//50;
  59.  
  60.   ! Produce the histogram:   ;
  61.       outtext("You typed "); outint(number_of_weights, 0);
  62.       outtext(" acceptable weights."); outimage;
  63.       outtext("The histogram:"); outimage; outimage;
  64.       outtext("Weight : Number of children"); outimage;
  65.       for weight_group := least_weight_group step 1  until greatest_weight_group do 
  66.         begin
  67.           outint(weight_group, 6); outtext(" : ");
  68.           number_of_asterisks := count(weight_group)/weights_per_asterisk;
  69.           for asterisk_number := 1 step 1  until number_of_asterisks 
  70.             do outchar('*');
  71.           setpos(6 + 3 + max_weights_in_group + 3);
  72.           outtext("("); outint(count(weight_group), 0); outtext(")"); 
  73.           outimage;
  74.         end of weight_group-repetition;
  75.       outimage;
  76.       if weights_per_asterisk > 1 then
  77.         begin
  78.           outint(weights_per_asterisk, 0); 
  79.           outtext(" weights for each *"); outimage; 
  80.           outimage;
  81.         end;
  82.  
  83.     end of not number_of_weights = 0;
  84.  
  85. end;
  86.